;; An interval in time is like "May 20 through May 25"

(in-package :timeclock)

(defclass time-interval ()
  ((start-time :accessor start-time
	       :initarg :start-time
	       :initform nil
	       :documentation "Starting time of interval")
   (stop-time :accessor stop-time
	      :initarg :stop-time
	      :initform nil
	      :documentation "Stopping time of interval"))
  (:documentation "An interval in time with a unique beginning and ending"))

(defmethod print-object ((object time-interval) stream)
  (print-unreadable-object (object stream :type t)
    (with-slots (start-time stop-time) object
      (format stream "[~A to ~A]~:[ INSANE~;~]"
	      (or start-time "unknown")
	      (or stop-time "unknown")
	      (sane-p object)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric start (interval)
  (:documentation "Start timing an interval"))

(defmethod start ((interval time-interval))
  (setf (start-time interval)
	(get-universal-time)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric stop (interval)
  (:documentation "Stop timing an interval"))

(defmethod stop ((interval time-interval))
  (setf (stop-time interval)
	(get-universal-time)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric sane-p (object)
  (:documentation "Is object sane? In other words, is all of the object's
state consistent?"))

;; If an interval is marked as ending before it begins, it is insane
(defmethod sane-p ((object time-interval))
  (with-slots (start-time stop-time) object
    (if (and start-time stop-time)
	(<= start-time stop-time)
	t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric duration (interval)
  (:documentation "Duration of a time interval"))

(defmethod duration ((interval time-interval))
  (assert (sane-p interval) (interval))
  (with-slots (start-time stop-time) interval
    (- stop-time start-time)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pprint-time (time &optional (stream *standard-output*))
  "Pretty-print a time to a given stream"
  (cybertiggyr-time:format-time stream
				"%B %d, %Y - %I:%M %p"
				time))

(define-presentation-type time-interval ())

(define-presentation-method present (interval (type time-interval) stream
				     (view textual-view) &key)
  (formatting-row (stream)
    (formatting-cell (stream)
      (pprint-time (start-time interval) stream))
    (formatting-cell (stream)
      (pprint-time (stop-time interval) stream))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric overlaps-p (x y)
  (:documentation "Do two things overlap?"))

(defmethod overlaps-p ((interval-1 time-interval) (interval-2 time-interval))
  (let ((s1 (start-time interval-1))
	(e1 (stop-time interval-1))
	(s2 (start-time interval-2))
	(e2 (stop-time interval-2)))
    (or (<= s1 s2 e1)
	(<= s1 e2 e1))))

(defgeneric merge-intervals (x y &optional safely-p)
  (:documentation "Merge two overlapping intervals together"))

(defmethod merge-intervals ((interval-1 time-interval)
			    (interval-2 time-interval)
			    &optional (safely-p t))
  (if (or (not safely-p)
	  (overlaps-p interval-1 interval-2))
      (let ((s1 (start-time interval-1))
	    (e1 (stop-time interval-1))
	    (s2 (start-time interval-2))
	    (e2 (stop-time interval-2)))
	(make-instance 'time-interval
		       :start-time (min s1 s2)
		       :stop-time (max e1 e2)))
      (error "Intervals ~S and ~S do not overlap"
	     interval-1 interval-2)))

#+nil
(overlaps-p (make-instance 'time-interval
			   :start-time 10 :stop-time 30)
	    (make-instance 'time-interval
			   :start-time 11 :stop-time 25))
#+nil
(merge-intervals (make-instance 'time-interval
				:start-time 10 :stop-time 30)
		 (make-instance 'time-interval
				:start-time 11 :stop-time 55))

;; FIXME: ?
#+nil
(defun sanitize-intervals (list)
  "If any intervals in a list overlap, merge them. Return the
new list."
  (let (ret)
    (dolist (x list)
      (if (overlaps-p x (car list))
	  (push )))))